home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / GNU-TILE-FORTH.lha / src / exceptions.v < prev    next >
Text File  |  1992-05-19  |  3KB  |  131 lines
  1. /*
  2.   C BASED FORTH-83 MULTI-TASKING KERNEL: EXCEPTION MANAGEMENT
  3.  
  4.   Copyright (C) 1988-1990 by Mikael R.K. Patel
  5.  
  6.   Computer Aided Design Laboratory (CADLAB)
  7.   Department of Computer and Information Science
  8.   Linkoping University
  9.   S-581 83 LINKOPING
  10.   SWEDEN
  11.  
  12.   Email: mip@ida.liu.se
  13.  
  14.   Started on: 30 June 1988
  15.  
  16.   Last updated on: 22 April 1990
  17.  
  18.   Dependencies:
  19.     (cc) kernel.c, kernel.h
  20.  
  21.   Description:
  22.     Error signal and exception extension vocabulary of the 
  23.     tile forth multi-tasking kernel.
  24.  
  25.   Copying:
  26.        This program is free software; you can redistribute it and/or modify
  27.        it under the terms of the GNU General Public License as published by
  28.        the Free Software Foundation; either version 1, or (at your option)
  29.        any later version.
  30.  
  31.        This program is distributed in the hope that it will be useful,
  32.        but WITHOUT ANY WARRANTY; without even the implied warranty of
  33.        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  34.        GNU General Public License for more details.
  35.  
  36.        You should have received a copy of the GNU General Public License
  37.        along with this program; see the file COPYING.  If not, write to
  38.        the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  39.  
  40. */
  41.  
  42. VOID doexception()
  43. {
  44.     spush(NIL, INT32);
  45.     spush(NORMAL, INT32);
  46.     spush(EXCEPTION, INT32);
  47.     spush(' ', INT32);
  48.     doword();
  49.     doentry();
  50. }
  51.  
  52. NORMAL_CODE(exception, forth, "exception", doexception);
  53.  
  54. VOID doparenexceptionsemicolon()
  55. {  
  56.     fthrow();
  57. }
  58.  
  59. COMPILATION_CODE(parenexceptionsemicolon, exception, "(exception;)", doparenexceptionsemicolon);
  60.  
  61. VOID doparenexceptionunlinksemicolon()
  62. {  
  63.     funlink();
  64.     fthrow();
  65. }
  66.  
  67. COMPILATION_CODE(parenexceptionunlinksemicolon, parenexceptionsemicolon, "(exceptionunlink;)", doparenexceptionunlinksemicolon);
  68.  
  69. VOID doparenexception()
  70. {   
  71.     fcatch();
  72. }
  73.  
  74. COMPILATION_CODE(parenexception, parenexceptionunlinksemicolon, "(exception>)", doparenexception);
  75.  
  76. VOID doexceptionsharp()
  77. {  
  78.     ENTRY t;
  79.  
  80.     /* Set up pointer to last definition */
  81.     dolast();
  82.     t = spop(ENTRY);
  83.     
  84.     /* Compile an exit of the current definition */
  85.     if (theframed != NIL) {    
  86.     spush(&parenexceptionunlinksemicolon, CODE_ENTRY);
  87.     }
  88.     else {
  89.     spush(&parenexceptionsemicolon, CODE_ENTRY);
  90.     }
  91.     dothread();
  92.     doremovelocals();
  93.     
  94.     /* Redefine the code type of the last definition */
  95.     t -> code = (INT32) dp;
  96.     
  97.     /* Compile the run time exception management definition */
  98.     spush(&parenexception, CODE_ENTRY);
  99.     dothread();
  100. }
  101.  
  102. COMPILATION_IMMEDIATE_CODE(exceptionsharp, parenexception, "exception>", doexceptionsharp);
  103.  
  104. VOID doraise()
  105. {  
  106.     INT32 s = spop(INT32);
  107.     
  108.     /* Check if there is an exception block available */
  109.     if (ep != NIL) {
  110.  
  111.     /* Restore the call environment */
  112.     rp = ep;
  113.     ep = (PTR32) rpop();
  114.     fp = (PTR32) rpop();
  115.     ip = (PTR32) rpop();
  116.     sp = (PTR) rpop();
  117.     tos.INT32 = rpop();
  118.  
  119.     /* Pass on the signal or exception to the exception block */
  120.     spush(s, INT32);
  121.     }
  122.     else {
  123.     
  124.     /* Call low level management of signal */
  125.     (VOID) error_signal(s);
  126.     }
  127. }
  128.  
  129. NORMAL_CODE(raise, exceptionsharp, "raise", doraise);
  130.  
  131.